﻿<%
class ActionDelegate
	private WX,System,Timespan
	private sub Class_Initialize()
	end sub
	public property set mSystem(value)
		set System = value
	end property
	public property set mWX(value)
		set WX = value
	end property
	public property let mTimespan(value)
		Timespan = value
	end property

	private function getResponse(delegate)
		dim L : set L = Model__("ResponseRules","Id").where("Disabled=0 and Delegate='" & delegate & "'").orderby("MatchType desc").query().fetch()
		if L.Eof() then
			if left(delegate,6)<>"event_" then set L = Model__("ResponseRules","Id").where("Disabled=0 and Delegate='event_click_default'").orderby("MatchType desc").query().fetch()
			if L.Eof() then
				set L = Model__("ResponseRules","Id").where("Disabled=0 and Delegate='event_default'").orderby("MatchType desc").query().fetch()
				if L.Eof() then set L = Model__("ResponseRules","Id").where("Disabled=0 and Delegate='global_default'").orderby("MatchType desc").query().fetch()
			end if
		end if
		set getResponse = L
	end function

	private function parseMediaMessage(byref R)
		'R.MsgType/R.Details
		dim Json:set Json = F.json(R.Details)
		if R.MsgType="text" then
			parseMediaMessage = WX.createTextResponse(Json.Content)
		elseif R.MsgType="image" then
			parseMediaMessage = WX.createImageResponse(Json.MediaId)
		elseif R.MsgType="voice" then
			parseMediaMessage = WX.createVoiceResponse(Json.MediaId)
		elseif R.MsgType="video" then
			parseMediaMessage = WX.createVideoResponse(Json.MediaId,Json.Title,Json.Description)
		elseif R.MsgType="music" then
			parseMediaMessage = WX.createMusicResponse(Json.Mediaid,Json.Title,Json.Description,Json.MusicUrl,Json.HQMusicUrl)
		elseif R.MsgType="news" then
			WX.News.clear()
			WX.News.append Json.Title,Json.Content,Json.Url,Json.PicUrl
			parseMediaMessage = WX.createNewsResponse()
		else
			parseMediaMessage = ""
		end if
	end function

	private function parseMsgId(Byref R)
		if isnumeric(R.MsgId) then
			dim L : set L = Model__("MediaMessages","Id").where("Id=" & R.MsgId).query().fetch()
			if L.Eof() then
				parseMsgId=""
			else
				parseMsgId = parseMediaMessage(L.Read())
			end if
		elseif R.MsgId="TEXT" then
			parseMsgId = WX.createTextResponse(R.Details)
		else
			dim Fn:Fn = getFnByMsgId(R.MsgId)
			if Fn(0)="" then
				parseMsgId = Mo(R.MsgId)(WX,System)
			else
				parseMsgId = Eval("Mo(Fn(1))." & Fn(0) & "(WX,System)")
			end if
		end if
	end function
	
	private function getFnByMsgId(byval MsgId)
		dim ary:ary = Split(MsgId,".")
		if Ubound(ary)=2 then
			getFnByMsgId = array(ary(2),Left(MsgId,instrrev(MsgId,".")-1))
		else
			getFnByMsgId = array("",MsgId)
		end if
	end function
	
	private function OnMessageMutiFinished(MsgID,Status,TotalCount,FilterCount,SentCount,ErrorCount)
		'群发消息结束时的事件推送
	end function

	private function OnReceiveLocation(Latitude,Longitude,Precision)
		'当用户推送一个位置时
		dim RM : set RM = getResponse("event_location")
		if not RM.Eof() then
			OnReceiveLocation = parseMsgId(RM.Read())
			OnReceiveLocation = Replace(OnReceiveLocation,"{$Latitude}",Latitude)
			OnReceiveLocation = Replace(OnReceiveLocation,"{$Longitude}",Longitude)
			OnReceiveLocation = Replace(OnReceiveLocation,"{$Precision}",Precision)
		end if
		dim address:address=""
		if not is_empty(System.Tx_key) then
			Mo.Use "TXAPI"
			dim TXAPI : set TXAPI = MoLibTXAPI.New(System.Tx_key)
			dim Gps : set Gps = TXAPI.Translate(Latitude & "," & Longitude)
			dim Pos : set Pos = TXAPI.Geoencoder(Gps.x & "," & Gps.y)
			if Pos.status=0 then address = Pos.result.address
		end if
		Model__("Location","Id").insert "OpenId",WX.FromUserName,"Location",Latitude & "," & Longitude,"StateDate",Timespan,"Address",address,"SrcId",System.Wx_Acount_SrcId
	end function
	private function OnClickMenu(EventKey)
		'当用户点击有效菜单时
		dim RM : set RM = getResponse(EventKey)
		if not RM.Eof() then
			OnClickMenu = parseMsgId(RM.Read())
			OnClickMenu = Replace(OnClickMenu,"{$EventKey}",EventKey)
		end if
	end function
	
	private function OnViewMenu(Url)
		'当用户点击菜单的链接时
		'OnViewMenu = WX.createTextResponse("[" & WX.Request.Event & "]")
	end function
	
	private function OnScanQrcode(SceneId,Ticket)
		'当用户扫描二维码时（用户已关注）
		dim RM : set RM = getResponse("event_scan_qrcode")
		if not RM.Eof() then
			OnScanQrcode = parseMsgId(RM.Read())
			OnScanQrcode = Replace(OnScanQrcode,"{$SceneId}",SceneId)
			OnScanQrcode = Replace(OnScanQrcode,"{$Ticket}",Ticket)
		end if
	end function

	private function OnSubscribeWithQrcode(SceneId,Ticket)
		'当用户通过扫描带场景的二维码并关注时
		Call OnSubscribe(1)
		dim RM : set RM = getResponse("event_subscribe_qrcode")
		if not RM.Eof() then
			OnSubscribeWithQrcode = parseMsgId(RM.Read())
			OnSubscribeWithQrcode = Replace(OnSubscribeWithQrcode,"{$SceneId}",SceneId)
			OnSubscribeWithQrcode = Replace(OnSubscribeWithQrcode,"{$Ticket}",Ticket)
		end if
	end function
	
	private function OnSubscribe(t)
		'当用户关注时
		dim L,RM,R,MsgId: set L = Model__("Subscriber","Id").where("OpenId='" & WX.FromUserName & "'").query().fetch()
		if L.Eof() then
			if t=1 or t=0 then Model__("Subscriber","Id").insert "OpenId",WX.FromUserName,"Subscribe",1,"SubscribeTime",Timespan,"LastMessageTime",Timespan,"SrcId", System.Wx_Acount_SrcId
			if t=2 then Model__("Subscriber","Id").insert "OpenId",WX.FromUserName,"Subscribe",1,"LastMessageTime",Timespan,"SrcId", System.Wx_Acount_SrcId
			if t=0 then
				set RM = getResponse("event_subscribe")
				if not RM.Eof() then OnSubscribe = parseMsgId(RM.Read())
			end if
			'认证过的公共账号才支持高级接口
			if System.Wx_Acount_Authed=1 and System.Wx_Acount_Type="服务号" then
				Mo.Use "WXServices"
				dim WXS : set WXS = MoLibWXServices.New(System.AppID,System.AppSecret)
				if WXS.getAccessToken() then
					dim json:set json = WXS.getUser(WX.FromUserName)
					if not json.error then
						Model__("Subscriber","Id").where("OpenId='" & WX.FromUserName & "'").update _
						"NickName",json.nickname,_
						"Sex",json.sex,_
						"Language",json.language,_
						"City",json.city,_
						"County",json.country,_
						"Province",json.province,_
						"Headimgurl",json.headimgurl,_
						"SubscribeTime",json.subscribe_time,_
						"Subscribe",1,_
						"Mode","none"
					end if
				end if
			end if
		else
			if t=1 or t=0 then Model__("Subscriber","Id").where("OpenId='" & WX.FromUserName & "'").update "Subscribe",1,"SubscribeTime",Timespan,"LastMessageTime",Timespan
			if t=2 then Model__("Subscriber","Id").where("OpenId='" & WX.FromUserName & "'").update "Subscribe",1,"LastMessageTime",Timespan
			if t=0 then
				set RM = getResponse("event_subscribere")
				if not RM.Eof() then OnSubscribe = parseMsgId(RM.Read())
			end if
		end if
	end function
	
	private function OnUnsubscribe()
		'当用户取消关注时
		Model__("Subscriber","Id").where("OpenId='" & WX.FromUserName & "'").update "Subscribe",0
	end function
	
	public function OnEvent()
		Call CheckState()
		if WX.Request.Event ="subscribe" then
			if F.string.startWith(WX.Request.EventKey,"qrscene_") and WX.Request.Ticket<>"" then
				OnEvent = OnSubscribeWithQrcode(Mid(WX.Request.EventKey,9),WX.Request.Ticket)
			else
				OnEvent = OnSubscribe(0)
			end if
		elseif WX.Request.Event ="unsubscribe" then
			OnUnsubscribe()
			OnEvent=""
		elseif WX.Request.Event ="LOCATION" then
			OnEvent = OnReceiveLocation(WX.Request.Latitude,WX.Request.Longitude,WX.Request.Precision)
		elseif WX.Request.Event ="CLICK" then
			OnEvent = OnClickMenu(WX.Request.EventKey)
		elseif WX.Request.Event ="VIEW" then
			OnEvent = OnViewMenu(WX.Request.EventKey)
		elseif WX.Request.Event ="SCAN" then
			OnEvent = OnScanQrcode(WX.Request.EventKey,WX.Request.Ticket)
		elseif WX.Request.Event ="MASSSENDJOBFINISH" then
			OnMessageMutiFinished _
			WX.Request.MsgID,_
			WX.Request.Status,_
			WX.Request.TotalCount,_
			WX.Request.FilterCount,_
			WX.Request.SentCount,_
			WX.Request.ErrorCount
			OnEvent=""
		else
			OnEvent = ""
		end if
	end function

	'****************************************************
	'@DESCRIPTION:	当接受到消息时，直接入库
	'@RETURN:	[Variant] description
	'****************************************************
	public function OnMessageArrived()
		Call CheckState()
		Mo.Use "JsonParser"
		Model__("Messages","Id").insert _
		"MsgType",WX.MsgType,_
		"ToUserName",WX.ToUserName,_
		"FromUserName",WX.FromUserName,_
		"CreateTime",F.timespan(),_
		"MsgId",WX.MsgId,_
		"Details",MoLibJsonParser.unParse(WX.Request)
		Call OnSubscribe(2)
		'Model__("Subscriber","Id").where("OpenId='" & WX.FromUserName & "'").update "LastMessageTime",WX.CreateTime
	end function
	public function OnResponseSent(Byval Details)
		Call CheckState()
		Mo.Use "XML"
		dim XML:set XML = MoLibXML.Load(Details)
		if not isnull(XML.root) then
			Mo.Use "JsonGenerater"
			dim ToUserName,FromUserName,CreateTime,MsgType
			ToUserName = XML.select("ToUserName").text()
			FromUserName = XML.select("FromUserName").text()
			CreateTime = XML.select("CreateTime").text()
			MsgType = XML.select("MsgType").text()
			dim Json : set Json=MOLibJsonGenerater.New()
			if MsgType="text" then
				Json.put "Content",XML.select("Content").text()
			elseif MsgType="image" then
				Json.put "MediaId",XML.select("Image/MediaId").text()
			elseif MsgType="voice" then
				Json.put "MediaId",XML.select("Voice/MediaId").text()
			elseif MsgType="video" then
				Json.put "MediaId",XML.select("Video/MediaId").text()
				Json.put "Title",XML.select("Video/Title").text()
				Json.put "Description",XML.select("Video/Description").text()
			elseif MsgType="music" then
				Json.put "Title",XML.select("Music/Title").text()
				Json.put "Description",XML.select("Music/Description").text()
				Json.put "MusicUrl",XML.select("Music/MusicUrl").text()
				Json.put "HQMusicUrl",XML.select("Music/HQMusicUrl").text()
				Json.put "ThumbMediaId",XML.select("Music/ThumbMediaId").text()
			elseif MsgType="news" then
				dim newslist:set newlist = Json.putnewarray("List")
				dim chds:set chds = XML.select("Articles").children()
				do while not chds.eof()
					dim chd:set chd = chds.next()
					dim n:set n = newlist.put(MOLibJsonGenerater.New())
					n.put "Title",XML.select("Title",chd).text()
					n.put "Description",XML.select("Description",chd).text()
					n.put "PicUrl",XML.select("PicUrl",chd).text()
					n.put "Url",XML.select("Url",chd).text()
				loop
			end if
			Model__("Messages","Id").insert _
			"MsgType",MsgType,_
			"ToUserName",ToUserName,_
			"FromUserName",FromUserName,_
			"CreateTime",CreateTime,_
			"MsgId",0,_
			"Details",Json.toString()
		end if
	end function
	private sub CheckState
		if not (isobject(System) and isobject(WX)) then F.exit "Illegal call"
	end sub
end class
%>